home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.06 Jun 88 / forth source / Graf3d.example < prev    next >
Encoding:
Text File  |  1988-04-19  |  8.9 KB  |  547 lines  |  [TEXT/MACH]
  1. \ Graf3d / Mach2 glue code
  2. \ An example for calling MPW routines from Forth
  3. \ J. Langowski April 1988
  4. \ ______________________________________________
  5.  
  6. Only Forth Also Mac Also Assembler
  7.  
  8. \ some general definitions first
  9. 16 CONSTANT portRect
  10. $9EE constant grayRgn
  11.  
  12. GLOBAL
  13.  CODE SCALE
  14.     MOVE.L   (A6)+,D0
  15.     BMI.S    @1
  16.     MOVE.L   (A6),D1
  17.     ASL.L    D0,D1
  18.     MOVE.L   D1,(A6)
  19.     RTS
  20. @1  MOVE.L   (A6),D1
  21.     NEG.L    D0
  22.     ASR.L    D0,D1
  23.     MOVE.L   D1,(A6)
  24.     RTS
  25. END-CODE
  26.  
  27. global
  28. CODE white
  29.     MOVE.L (A5),-(A6)
  30.     SUBQ.L #8,(A6)
  31.     RTS
  32. END-CODE MACH
  33.  
  34. global
  35. CODE black
  36.     MOVE.L (A5),-(A6)
  37.     SUBI.L #16,(A6)
  38.     RTS
  39. END-CODE MACH
  40.  
  41. global
  42. CODE gray
  43.     MOVE.L (A5),-(A6)
  44.     SUBI.L #24,(A6)
  45.     RTS
  46. END-CODE MACH
  47.  
  48. : 4ASCII 
  49.  0
  50. 4 0 DO
  51.   8 SCALE 0 WORD 1+ C@ + 
  52. LOOP
  53. ;
  54.  
  55. 4ASCII gr3D CONSTANT "gr3D \ resource ID
  56.  
  57. \ Graf3D jump table
  58.  
  59. CREATE    gInitGrf3D
  60. CREATE    gOpen3DPort    
  61. CREATE    gSetPort3D    
  62. CREATE    gGetPort3D    
  63. CREATE    gMoveTo2D    
  64. CREATE    gMoveTo3D
  65. CREATE    gLineTo2D
  66. CREATE    gLineTo3D
  67. CREATE    gMove2D
  68. CREATE    gMove3D
  69. CREATE    gLine2D
  70. CREATE    gLine3D
  71. CREATE    gViewPort
  72. CREATE    gLookAt
  73. CREATE    gViewAngle
  74. CREATE    gIdentity
  75. CREATE    gScale
  76. CREATE    gTranslate
  77. CREATE    gPitch
  78. CREATE    gYaw
  79. CREATE    gRoll
  80. CREATE    gSkew
  81. CREATE    gTransform
  82. CREATE    gClip3D
  83. CREATE    gSetPt3D
  84. CREATE    gSetPt2D
  85.  
  86. \ The glue code is 2636 bytes long, so we allocate
  87. \ sufficient additional buffer space to put it into
  88. 2600 ALLOT
  89.  
  90. : Init3D \ gets Graf3D code from gr3D=1 resource 
  91.      \ and copies it into buffer
  92.     "gr3D 1 call GetResource
  93.     dup @ swap call SizeRsrc
  94.     ['] gInitGrf3D swap cmove
  95. ;
  96.  
  97. CODE InitGrf3d    ( globalPtr -- )
  98.     EXG    D4,A7
  99.     MOVE.L    (A6)+,-(A7)
  100.     JSR    gInitGrf3d
  101.     EXG    D4,A7
  102.     RTS
  103. END-CODE
  104.  
  105. CODE Open3DPort    ( port -- )
  106.     EXG    D4,A7
  107.     MOVE.L    (A6)+,-(A7)
  108.     JSR    gOpen3DPort
  109.     EXG    D4,A7
  110.     RTS
  111. END-CODE
  112.  
  113. CODE SetPort3d    ( port -- )
  114.     EXG    D4,A7
  115.     MOVE.L    (A6)+,-(A7)
  116.     JSR    gSetPort3d
  117.     EXG    D4,A7
  118.     RTS
  119. END-CODE
  120.  
  121. CODE GetPort3d    ( VAR port -- )
  122.     EXG    D4,A7
  123.     MOVE.L    (A6)+,-(A7)
  124.     JSR    gGetPort3d
  125.     EXG    D4,A7
  126.     RTS
  127. END-CODE
  128.  
  129. CODE MoveTo2d    ( x y -- )
  130.     EXG    D4,A7
  131.     MOVE.L    4(A6),-(A7)
  132.     MOVE.L    (A6),-(A7)
  133.     ADDA.W    #8,A6
  134.     JSR    gMoveTo2d
  135.     EXG    D4,A7
  136.     RTS
  137. END-CODE
  138.  
  139. CODE MoveTo3d    ( x y z -- )
  140.     EXG    D4,A7
  141.     MOVE.L    8(A6),-(A7)
  142.     MOVE.L    4(A6),-(A7)
  143.     MOVE.L    (A6),-(A7)
  144.     ADDA.W    #12,A6
  145.     JSR    gMoveTo3d
  146.     EXG    D4,A7
  147.     RTS
  148. END-CODE
  149.  
  150. CODE LineTo2d    ( x y -- )
  151.     EXG    D4,A7
  152.     MOVE.L    4(A6),-(A7)
  153.     MOVE.L    (A6),-(A7)
  154.     ADDA.W    #8,A6
  155.     JSR    gLineTo2d
  156.     EXG    D4,A7
  157.     RTS
  158. END-CODE
  159.  
  160. CODE LineTo3d    ( x y z -- )
  161.     EXG    D4,A7
  162.     MOVE.L    8(A6),-(A7)
  163.     MOVE.L    4(A6),-(A7)
  164.     MOVE.L    (A6),-(A7)
  165.     ADDA.W    #12,A6
  166.     JSR    gLineTo3d
  167.     EXG    D4,A7
  168.     RTS
  169. END-CODE
  170.  
  171. CODE Move2d    ( dx dy -- )
  172.     EXG    D4,A7
  173.     MOVE.L    4(A6),-(A7)
  174.     MOVE.L    (A6),-(A7)
  175.     ADDA.W    #8,A6
  176.     JSR    gMove2d
  177.     EXG    D4,A7
  178.     RTS
  179. END-CODE
  180.  
  181. CODE Move3d    ( dx dy dz -- )
  182.     EXG    D4,A7
  183.     MOVE.L    8(A6),-(A7)
  184.     MOVE.L    4(A6),-(A7)
  185.     MOVE.L    (A6),-(A7)
  186.     ADDA.W    #12,A6
  187.     JSR    gMove3d
  188.     EXG    D4,A7
  189.     RTS
  190. END-CODE
  191.  
  192. CODE Line2d    ( x y -- )
  193.     EXG    D4,A7
  194.     MOVE.L    4(A6),-(A7)
  195.     MOVE.L    (A6),-(A7)
  196.     ADDA.W    #8,A6
  197.     JSR    gLine2d
  198.     EXG    D4,A7
  199.     RTS
  200. END-CODE
  201.  
  202. CODE Line3d    ( x y z -- )
  203.     EXG    D4,A7
  204.     MOVE.L    8(A6),-(A7)
  205.     MOVE.L    4(A6),-(A7)
  206.     MOVE.L    (A6),-(A7)
  207.     ADDA.W    #12,A6
  208.     JSR    gLine3d
  209.     EXG    D4,A7
  210.     RTS
  211. END-CODE
  212.  
  213. CODE ViewPort    ( r -- )
  214.     EXG    D4,A7
  215.     MOVE.L    (A6)+,-(A7)
  216.     JSR    gViewPort
  217.     EXG    D4,A7
  218.     RTS
  219. END-CODE
  220.  
  221. CODE LookAt    ( left top right bottom -- )
  222.     EXG    D4,A7
  223.     MOVE.L    12(A6),-(A7)
  224.     MOVE.L    8(A6),-(A7)
  225.     MOVE.L    4(A6),-(A7)
  226.     MOVE.L    (A6),-(A7)
  227.     ADDA.W    #16,A6
  228.     JSR    gLookAt
  229.     EXG    D4,A7
  230.     RTS
  231. END-CODE
  232.  
  233. CODE ViewAngle    ( angle -- )
  234.     EXG    D4,A7
  235.     MOVE.L    (A6)+,-(A7)
  236.     JSR    gViewAngle
  237.     EXG    D4,A7
  238.     RTS
  239. END-CODE
  240.  
  241. CODE Identity
  242.     EXG    D4,A7
  243.     JSR    gIdentity
  244.     EXG    D4,A7
  245.     RTS
  246. END-CODE
  247.  
  248. CODE Scal    ( xfactor yfactor zfactor -- )
  249.     EXG    D4,A7
  250.     MOVE.L    8(A6),-(A7)
  251.     MOVE.L    4(A6),-(A7)
  252.     MOVE.L    (A6),-(A7)
  253.     ADDA.W    #12,A6
  254.     JSR    gScale
  255.     EXG    D4,A7
  256.     RTS
  257. END-CODE
  258.  
  259. CODE Translate    ( dx dy dz -- )
  260.     EXG    D4,A7
  261.     MOVE.L    8(A6),-(A7)
  262.     MOVE.L    4(A6),-(A7)
  263.     MOVE.L    (A6),-(A7)
  264.     ADDA.W    #12,A6
  265.     JSR    gTranslate
  266.     EXG    D4,A7
  267.     RTS
  268. END-CODE
  269.  
  270. CODE Pitch    ( xangle -- )
  271.     EXG    D4,A7
  272.     MOVE.L    (A6)+,-(A7)
  273.     JSR    gPitch
  274.     EXG    D4,A7
  275.     RTS
  276. END-CODE
  277.  
  278. CODE Yaw    ( yangle -- )
  279.     EXG    D4,A7
  280.     MOVE.L    (A6)+,-(A7)
  281.     JSR    gYaw
  282.     EXG    D4,A7
  283.     RTS
  284. END-CODE
  285.  
  286. CODE Rol    ( zangle -- )
  287.     EXG    D4,A7
  288.     MOVE.L    (A6)+,-(A7)
  289.     JSR    gRoll
  290.     EXG    D4,A7
  291.     RTS
  292. END-CODE
  293.  
  294. CODE Skew    ( zangle -- )
  295.     EXG    D4,A7
  296.     MOVE.L    (A6)+,-(A7)
  297.     JSR    gSkew
  298.     EXG    D4,A7
  299.     RTS
  300. END-CODE
  301.  
  302. CODE Transform    ( src dst -- )
  303.     EXG    D4,A7
  304.     MOVE.L    4(A6),-(A7)
  305.     MOVE.L    (A6),-(A7)
  306.     ADDA.W    #8,A6
  307.     JSR    gTransform
  308.     EXG    D4,A7
  309.     RTS
  310. END-CODE
  311.  
  312. CODE Clip3D    ( src1 src2 dst1 dst2 -- flag )
  313.     EXG    D4,A7
  314.     CLR.W    -(A7)
  315.     MOVE.L    12(A6),-(A7)
  316.     MOVE.L    8(A6),-(A7)
  317.     MOVE.L    4(A6),-(A7)
  318.     MOVE.L    (A6),-(A7)
  319.     ADDA.W    #16,A6
  320.     JSR    gClip3D
  321.     MOVE.W    (A7)+,D0
  322.     EXT.L    D0
  323.     MOVE.L    D0,-(A6)
  324.     EXG    D4,A7
  325.     RTS
  326. END-CODE
  327.  
  328. CODE SetPt3d    ( pt3D x y z -- )
  329.     EXG    D4,A7
  330.     MOVE.L    12(A6),-(A7)
  331.     MOVE.L    8(A6),-(A7)
  332.     MOVE.L    4(A6),-(A7)
  333.     MOVE.L    (A6),-(A7)
  334.     ADDA.W    #16,A6
  335.     JSR    gSetPt3D
  336.     EXG    D4,A7
  337.     RTS
  338. END-CODE
  339.  
  340. CODE SetPt2d    ( pt2D x y -- )
  341.     EXG    D4,A7
  342.     MOVE.L    8(A6),-(A7)
  343.     MOVE.L    4(A6),-(A7)
  344.     MOVE.L    (A6),-(A7)
  345.     ADDA.W    #12,A6
  346.     JSR    gSetPt2D
  347.     EXG    D4,A7
  348.     RTS
  349. END-CODE
  350.  
  351. \ Translation of Boxes.pas example into Forth follows
  352. \ ___________________________________________________
  353.  
  354. : .x ; mach
  355. : .y 4 + ; mach
  356. : .z 8 + ; mach
  357.  
  358. : .pt1 ; mach
  359. : .pt2 12 + ; mach
  360.  
  361. 15 CONSTANT BoxCount
  362. Variable MyPort     104 vallot \ grafPort is 108 bytes long
  363. Variable MyPort3D     150 vallot \ graf3DPort is 154 bytes long
  364. Variable boxArray   24 BoxCount * vallot 
  365.                 \ BoxCount * 2* point3D @ 3 long words
  366. Variable nboxes               \ # of boxes made
  367. Variable MyBox          20 vallot \ 24 bytes for 2* point3d
  368. Variable p1           8 vallot \ point3d
  369. Variable p2           8 vallot \ point3d
  370. Variable myRect       4 vallot \ Rect
  371. Variable testRect       4 vallot \ Rect
  372.  
  373. : DrawBrick { pt1 pt2 | tempRgn -- }
  374.     call NewRgn -> tempRgn
  375.  
  376.     call OpenRgn    
  377.     pt1 .x @ pt1 .y @ pt1 .z @ MoveTo3D
  378.     pt1 .x @ pt1 .y @ pt2 .z @ LineTo3D
  379.     pt2 .x @ pt1 .y @ pt2 .z @ LineTo3D
  380.     pt2 .x @ pt1 .y @ pt1 .z @ LineTo3D
  381.     pt1 .x @ pt1 .y @ pt1 .z @ LineTo3D    
  382.     tempRgn call CloseRgn
  383.     tempRgn white call FillRgn
  384.  
  385.     call OpenRgn
  386.     pt1 .x @ pt1 .y @ pt2 .z @ MoveTo3D
  387.     pt1 .x @ pt2 .y @ pt2 .z @ LineTo3D
  388.     pt2 .x @ pt2 .y @ pt2 .z @ LineTo3D
  389.     pt2 .x @ pt1 .y @ pt2 .z @ LineTo3D
  390.     pt1 .x @ pt1 .y @ pt2 .z @ LineTo3D    
  391.     tempRgn call CloseRgn
  392.     tempRgn gray call FillRgn
  393.  
  394.     call OpenRgn    
  395.     pt2 .x @ pt1 .y @ pt1 .z @ MoveTo3D
  396.     pt2 .x @ pt1 .y @ pt2 .z @ LineTo3D
  397.     pt2 .x @ pt2 .y @ pt2 .z @ LineTo3D
  398.     pt2 .x @ pt2 .y @ pt1 .z @ LineTo3D
  399.     pt2 .x @ pt1 .y @ pt1 .z @ LineTo3D    
  400.     tempRgn call CloseRgn
  401.     tempRgn black call FillRgn
  402.  
  403.     white call penpat
  404.     pt2 .x @ pt2 .y @ pt2 .z @ MoveTo3D
  405.     pt2 .x @ pt2 .y @ pt1 .z @ LineTo3D
  406.     pt2 .x @ pt1 .y @ pt1 .z @ LineTo3D
  407.     call pennormal
  408.  
  409.     tempRgn call DisposRgn
  410. ;
  411.  
  412. : hi -16 scale ;
  413.  
  414. : chkBox { | box -- }
  415.     1 ( flag )
  416.     nBoxes @ 0 DO
  417.         boxArray i 24 * + -> box
  418.         testRect  
  419.         box .pt1 .x @ hi   
  420.         box .pt1 .y @ hi 
  421.         box .pt2 .x @ hi 
  422.         box .pt2 .y @ hi  call SetRect
  423.         testRect -1 -1 call InSetRect
  424.         myRect testRect testRect call SectRect
  425.         IF drop 0 leave THEN
  426.     LOOP
  427. ;
  428.  
  429. : MakeBox { | p1x p1y p1z p2x p2y p2z box ii -- }
  430.     call random 70 mod 15 - 1 call FixRatio -> p1x
  431.     call random 70 mod 10 - 1 call FixRatio -> p1y
  432.     0 -> p1z
  433.  
  434.     call random 30 mod abs 10 + 1 call FixRatio p1x + -> p2x
  435.     call random 45 mod abs 10 + 1 call FixRatio p1y + -> p2y
  436.     call random 30 mod abs 10 + 1 call FixRatio p1z + -> p2z
  437.  
  438.     myRect p1x hi p1y hi p2x hi p2y hi call SetRect
  439.  
  440.     chkBox IF
  441.         p1x myBox .pt1 .x !
  442.         p1y myBox .pt1 .y !
  443.         p1z myBox .pt1 .z !
  444.         p2x myBox .pt2 .x !
  445.         p2y myBox .pt2 .y !
  446.         p2z myBox .pt2 .z !
  447.  
  448.         0 -> ii
  449.         myBox boxArray nBoxes @ 24 * + 24 cmove
  450.  
  451.         BEGIN
  452.         myBox .pt1 .y @  boxArray ii + .pt2 .y @ >
  453.         myBox .pt2 .y @  boxArray ii + .pt1 .y @ > and
  454.         myBox .pt1 .x @  boxArray ii + .pt2 .x @ <
  455.         myBox .pt2 .x @  boxArray ii + .pt1 .x @ < and or
  456.         WHILE
  457.             24 +> ii
  458.         REPEAT
  459.         ii 24 / -> ii
  460.  
  461.         ii 1+ nBoxes @ DO
  462.             boxArray i 1- 24 * +
  463.             boxArray i 24 * + 
  464.             24 cmove
  465.         -1 +loop
  466.         myBox boxArray ii 24 * + 24 cmove
  467.         
  468.         1 nBoxes +!
  469.     THEN
  470. ;
  471.  
  472. : drawGrid
  473.     11 -10 DO
  474.         i 10 * 1 call FixRatio -100 1 call FixRatio 0
  475.         MoveTo3D
  476.         i 10 * 1 call FixRatio  100 1 call FixRatio 0
  477.         LineTo3D
  478.     LOOP
  479.  
  480.     11 -10 DO
  481.         -100 1 call FixRatio i 10 * 1 call FixRatio 0
  482.         MoveTo3D
  483.          100 1 call FixRatio i 10 * 1 call FixRatio 0
  484.         LineTo3D
  485.     LOOP
  486. ;
  487.  
  488. : restore.screen
  489.     call drawmenubar
  490.     call frontwindow 
  491.     grayrgn @ call paintbehind
  492.     call showcursor
  493. ;
  494.  
  495. : main
  496.     init3d
  497.     call hidecursor
  498.     myPort call OpenPort
  499.     myPort3D Open3DPort
  500.     myPort portRect + ViewPort
  501.     -100 1 call FixRatio  75 1 call FixRatio
  502.      100 1 call FixRatio -75 1 call FixRatio
  503.         LookAt
  504.     30 1 call FixRatio ViewAngle
  505.     Identity
  506.     20 1 call FixRatio Rol
  507.     70 1 call FixRatio Pitch 
  508.  
  509.     BEGIN
  510.         myPort3D SetPort3D
  511.         0 nBoxes !
  512.         BEGIN makeBox nBoxes @ boxCount = UNTIL
  513.  
  514.         white call penPat
  515.         black call backPat
  516.         myPort portRect + call EraseRect
  517.  
  518.         drawGrid
  519.  
  520.         0 nBoxes @ 1- DO
  521.             boxArray i 24 * + dup .pt1 swap .pt2 DrawBrick
  522.         -1 +LOOP 
  523.             
  524.     ?terminal UNTIL
  525.     restore.screen
  526.     bye
  527. ;
  528.  
  529.  
  530. NEW.WINDOW Boxes
  531. " Boxes" Boxes TITLE
  532. 0 0 20 20 Boxes BOUNDS
  533. Plain Visible NoCloseBox NoGrowBox Boxes ITEMS
  534.  
  535. 600 5000 terminal Box
  536.  
  537. : go.box activate main ;
  538.  
  539. : start
  540.     Boxes add
  541.     Boxes Box build
  542.     Box go.Box
  543. ;             
  544.  
  545. .( To create a turkey application ) cr
  546. .( type TURNKEY START BOXES )
  547.